use 5.10.0;
use strict;

package Graphics::PlanarVector::Path;
use Graphics::PlanarVector::Transform qw/matrix_scale matrix_rotate matrix PI/;
use Carp;

our $fmt = "%.3f";

sub _tan { sin($_[0])/cos($_[0]) }

use constant ARC_SEG=>2;
use constant ARC_RATIO=>_tan(PI/4/ARC_SEG) * 4/3;

sub SVG_arcto {
	my ($path, $relative, $rx, $ry, $rot, $large, $sweep, $x, $y) = @_;
	my $cur = $path->current_point;
	my $d = $relative ? (vector($x, $y) + $cur) : vector($x, $y);
	my $dest;
	$rx = abs $rx;
	$ry = abs $ry;
	if (!$rx || !$ry) {
		$path->curveto($dest);
		return;
	}
	$rot = 0 if $rx == $ry;

	my ($m, $inv) = (matrix(1,0,0,1,0,0), matrix(1,0,0,1,0,0));
	if ($rot) {
		$m = matrix_rotate(-$rot) * $m;
		$inv = $inv * matrix_rotate($rot);
	}

	$m = matrix_scale(1/$rx, 1/$ry) * $m;
	$inv = $inv * matrix_scale($rx, $ry);

	if (!$sweep) {
		$m = matrix_scale(1,-1) * $m;
		$inv = $inv * matrix_scale(1,-1);
	}

	($cur, $dest) = map {$_->transform($m)} ($cur, $d);
	my ($r, $h) = sqrt($cur->dist2($dest))/2;
	if ($r < 1) {
		$h = sqrt(1 - $r*$r);
		$r = 1;
	} else {
		$h = 0;
	}
	my $diff = ($dest - $cur)->normalize;
	$h = -$h if $large;

	my $center = ($dest + $cur)/2 + $h * $diff->rotate(90);
	my ($a1, $a2) = (($cur-$center)->angle() * ARC_SEG/PI,
			($dest-$center)->angle() * ARC_SEG/PI);
	if ($a1 < 0) { $a1+= 2 * ARC_SEG }
	while ($a2 <= $a1) { $a2 += 2 * ARC_SEG }

	my @as = ($a1);
	for (int($a1) .. int($a2)) {
		next if $_ <= $a1;
		last if $_ >= $a2;
		push @as, $_
	}
	push @as, $a2;
	shift @as if $as[1] - $as[0] < 1e-4;
	return if (@as < 2);

	pop @as if $as[-1] - $as[-2] < 1e-4;
	return if (@as < 2);

	my @pts = map { $center + vector($r * cos($_* PI/ARC_SEG), $r * sin($_* PI/ARC_SEG)) } @as;
	my @adiff;
	for (1 .. $#as) { push @adiff, $as[$_] - $as[$_-1] }
	my @segs;
	for (0 .. $#adiff) {
		my $dc = vector(0, $adiff[$_] == 1
					? $r * ARC_RATIO
					: $r * _tan($adiff[$_] * (PI/4/ARC_SEG)) * 4/3);
		push @segs, path_segment($pts[$_],
					$pts[$_]+$dc->rotate($as[$_]*(180/ARC_SEG)),
					$pts[$_+1]-$dc->rotate($as[$_+1]*(180/ARC_SEG)),
					$pts[$_+1])
	}
	@segs = map { $_->transform($inv)->{pt} } @segs;
	$segs[-1][-1] = $d;
	for (@segs) {
		shift @$_;
		$path->curveto(@$_)
	}
}

sub _n {
	s/^[\s,]*([-+]?(\d+(\.\d*)?|\.\d+)([eE][-+]?\d+)?)//
		and return $1
		or die;
}

sub SVG_in {
	my $p = shift;
	local $_ = $_[0];
	my $cmd;
	eval {
		s/^[\s,]*//;
		while (length $_) {
			if (s/^([mlczqstvha])//i) {
				$cmd = $1
			}
			given($cmd) {
			when('z'){ $p->closepath, $cmd = ''}
			when('Z'){ $p->closepath; $cmd = '' }
			when('M'){ $p->moveto(&_n, &_n); $cmd = 'L' }
			when('m'){ $p->rmoveto(&_n, &_n); $cmd = 'l' }
			when('L'){ $p->curveto(&_n, &_n) }
			when('l'){ $p->rcurveto(&_n, &_n) }
			when('C'){ $p->curveto(&_n, &_n, &_n, &_n, &_n, &_n)}
			when('c'){ $p->rcurveto(&_n, &_n, &_n, &_n, &_n, &_n)}
			when('Q'){ $p->curveto(&_n, &_n, &_n, &_n)}
			when('q'){ $p->rcurveto(&_n, &_n, &_n, &_n)}
			when('S'){ $p->smoothto(&_n, &_n, &_n, &_n)}
			when('s'){ $p->rsmoothto(&_n, &_n, &_n, &_n)}
			when('T'){ $p->smoothto(&_n, &_n)}
			when('t'){ $p->rsmoothto(&_n, &_n)}
			when('V'){ $p->curveto(($p->current_point)->[0], &_n) }
			when('v'){ $p->rcurveto(0, &_n) }
			when('H'){ $p->curveto(&_n, ($p->current_point)->[1]) }
			when('h'){ $p->rcurveto(&_n, 0) }
			when('A'){ $p->SVG_arcto(0, &_n, &_n, &_n, &_n, &_n, &_n,&_n) }
			when('a'){ $p->SVG_arcto(1, &_n, &_n, &_n, &_n, &_n, &_n,&_n) }

			default{ die "bad SVG command $cmd" }
			}
			s/^[\s,]*//;
		}
		die if length;
	};
	if ($@) {
		print STDERR $@;
		croak "Bad SVG path data $_[0]\nbefore\n\t'$_',"
	}
	$p;
}

sub SVG_out {
	join	' ',
		map  { $_->SVG_out }
		shift->kids
}

package Graphics::PlanarVector::SubPath;

*fmt = \$Graphics::PlanarVector::SubPath::fmt;

sub _eq { shift->dist2(shift) < 1e-6 }

sub _nout { sprintf($fmt, shift) + 0 }

sub _pout {
	map { _nout($_->[0]).','. _nout($_->[1]) } @_
}

sub SVG_out {
	my $sp = shift;
	my @segs = $sp->kids or return '';
	if ($sp->{closed}) {
		for (my $i = $#segs; $i >= 0; $i--) {
			if ($segs[$i]->order == 1) {
				my @m = splice @segs, 0, $i + 1;
				pop @m;
				push @segs, @m;
				$sp->{start} = $segs[0]{pt}[0];
				last;
			}
		}
	}

	my $cur = $segs[0]{pt}[0];
	my ($cmd, @out) = ('L', "M", _pout($cur));
	my ($last, $newcmd, @nums, $newpt);
	for my $seg (@segs) {
		$newpt = $seg->{pt}[-1];
		@nums = ();
		given($seg->order) {
		when(1) {
			if (abs($newpt->[0] - $cur->[0]) < 1e-6) {
				$newcmd = 'V';
				@nums = _nout $newpt->[1];
			} elsif (abs($newpt->[1] - $cur->[1]) < 1e-6) {
				$newcmd = 'H';
				@nums = _nout $newpt->[0];
			} else {
				$newcmd = 'L';
				@nums = _pout $newpt;
			}
		}
		when(2) {
			my $c = $seg->{pt}[1];
			if ($last and $last->order == 2) {
				my $cold = $last->{pt}[1];
				if (_eq($cur, ($cold + $c)/2)) {
					$newcmd = 'T';
					@nums = _pout $newpt;
					next
				}
			}
			$newcmd = 'Q';
			@nums = _pout($c, $newpt);
		}
		when(3) {
			my ($c1, $c2) = @{$seg->{pt}}[1,2];
			if ($last and $last->order == 3) {
				my $cold = $last->{pt}[2];
				if (_eq($cur, ($cold + $c1)/2)) {
					$newcmd = 'S';
					@nums = _pout($c2, $newpt);
					next
				}
			}
			$newcmd = 'C';
			@nums = _pout($c1, $c2, $newpt)
		}}
	} continue {
		if ($newcmd ne $cmd) {
			push @out, $newcmd;
		}
		push @out, @nums;
		$cmd = $newcmd;
		$last = $seg;
		$cur = $newpt;
	}
	push @out, 'Z' if $sp->{closed};
	join(' ', @out);
}

package Graphics::SVG::Path;
use Graphics::PlanarVector::Path 'path';
use Graphics::SVG::Element ':basic';
add_svg_tag 'path';

sub new {
	my $self = &default_new;
	$self->{path} //= path;
	$self->{attr}{d} //= path->SVG_out;
	$self
}

sub attr_d {
	my ($self, $name, $value) = @_;
	if (defined $value) {
		$self->{path} = path->SVG_in($value);
		default_attr $self, d=>$self->{path}->SVG_out
	} else {
		return $self->{path}->SVG_out
	}
}

sub handle_attr {
	my ($self, $name) = @_;
	given ($name) {
		when('d') { return \&attr_d }
	}
}

1;
__END__

=head1 Name

Graphics::SVG::Path -- SVG path object class.  Also provides SVG path data input/output
for L<Graphics::PlanarVector::Path> module.

=head1 SYNOPSIS

    use Graphics::SVG::Path;
    $svg_path = Graphics::SVG::Path->new(d=>'M0,0 a10,10 0 0 0 5,5 q3,2 4,-1');
    
    use Graphics::PlanarVector::Path 'path';
    $path2 = path;
    $path2->SVG_in('M0,0 H 100 V100 H-100 z');
    $path2 = $path + $svg_path->{path}
    print $path2->SVG_out;

=head1 FUNCTIONS

=over 4

=item B<SVGpath>(STRING)

Importable function that produces a L<Graphics::PlanarVector::Path> object.
If STRING is provided, its content is parsed according to SVG path data format
specification.

=item $path->B<SVG_in>(STRING)

Method for a L<Graphics::PlanarVector::Path> object.  Parses STRING according
to SVG path data format and append resulting content to $path.

=item $path->B<SVG_out>

Method for a L<Graphics::PlanarVector::Path> object.  Returns a string
following the SVG path data format.

=back

=head1 BUGS & MALFEATURES

B<SVG_in> is more liberal about what it takes in than SVG spec says.  Valid
path data string should parse correctly, though.

B<SVG_in> can parse 'a' and 'A' path data, but produces a cubic Bezier
approximating the arc instead.  The identity of being an arc is completely lost.

B<SVG_out> uses '%.3f' as default output format for numbers via C<sprintf>.
Users can change it by setting package variable C<$fmt>:

    {
        local $Graphics::PlanarVector::Path::fmt = '%7.5g';
        print $path->SVG_out;
    }

